home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0103_Bounce v1.1.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  8KB  |  246 lines
  1. (*
  2.   From: Christian Ramsvik
  3.   Subj: bounce    v1.0
  4. Origin: Hatlane Point #9 (2:211/10.9)
  5.  
  6. HI!  Got a bouncing procedure a while ago.  It bounces a ball, and you can
  7. increase speed in X- and Y-axis by pressing the arrow keys.  I'm sure you can
  8. extract what you need from this one:
  9.  
  10.  
  11.   From: John Howard  jh
  12.   Subj: bounce    v1.1
  13. Origin: Synergy (1:280/66)
  14. Upgraded to vary the ball size with / and *.  Compass directions use keypad in
  15. numlock mode or UIOJKNM, keys.  The speed can be changed in each direction.
  16. The gravity effect can vary with + and - keys.  Status report dialog box when
  17. either space or 0 key pressed.  Press 0 again will stop all motion.  Press
  18. keypad_5 will halt display and requires pressing ESCape key to continue.  A
  19. period will reset the ball to default size.
  20. *)
  21.  
  22. program Bounce;
  23. uses Crt, Graph;
  24. {-$DEFINE solid}
  25. {-$DEFINE bubble}
  26. { jh
  27. const
  28.      MinBalls = 1;
  29.      MaxBalls = 2;
  30. }
  31. type
  32.     TImage = record
  33.                XPos,                   {x}       {horizontal position}
  34.                YPos    : Integer;      {y}       {vertical position}
  35.                XSpeed,                 {dx}      {actually a velocity}
  36.                YSpeed  : Integer;      {dy}      {actually a velocity}
  37.                XAccel,                 {ddx}     {jh unused acceleration}
  38.                YAccel  : Integer;      {ddy}     {jh unused acceleration}
  39.  
  40.                Radius  : Byte;         {Ball}
  41.              end;
  42.  
  43. var
  44.    Ch     : Char;
  45.    Gd, Gm : Integer;
  46.    Image  : {array [MinBalls..MaxBalls] of} TImage;   {jh}
  47.    FullSpeed,                                         {jh}
  48.    HalfSpeed : Integer;           { = FullSpeed div 2}
  49.    {BallNumber : byte;}                               {jh}
  50.  
  51. { ******************* DRAW IMAGE ********************* }
  52. procedure DrawImage;
  53. begin
  54.    SetColor( White );
  55. {$IFDEF solid}
  56.    SetFillStyle( SolidFill, White );
  57. {$ELSE}
  58.    SetFillStyle( HatchFill, White );
  59. {$ENDIF}
  60.  
  61.    with Image do
  62.    begin
  63. {$IFDEF bubble}
  64.       Circle( XPos, YPos, Radius );              {jh Soap bubble}
  65. {$ELSE}
  66.       PieSlice( XPos, YPos, 0, 360, Radius );    {jh Pattern ball}
  67. {$ENDIF}
  68.    end;
  69. end;
  70.  
  71. { ******************* REMOVE IMAGE ******************** }
  72. procedure RemoveImage;
  73. begin
  74.    SetColor( Black );
  75. {$IFDEF solid}
  76.    SetFillStyle( SolidFill, Black );
  77. {$ELSE}
  78.    SetFillStyle( HatchFill, Black );
  79. {$ENDIF}
  80.  
  81.    with Image do
  82.    begin
  83. {$IFDEF bubble}
  84.       Circle( XPos, YPos, Radius );              {jh Soap bubble}
  85. {$ELSE}
  86.       PieSlice( XPos, YPos, 0, 360, Radius );    {jh Pattern ball}
  87. {$ENDIF}
  88.    end;
  89. end;
  90.  
  91. { ******************* UPDATE SPEED ******************** }
  92. procedure UpdateSpeed;
  93.  
  94.          function IntToStr(I: Longint): String;
  95.          { convert any integer to a string }
  96.          var  S: string[11];
  97.          begin
  98.            Str(I,S);
  99.            IntToStr := S;
  100.          end;
  101. begin
  102.    while KeyPressed do
  103.    begin
  104.      Ch := ReadKey;
  105.      Ch := Upcase(Ch);
  106.      case Ch of  { Change speed with keypad numbers }
  107. {jh Note: Keypad_5 causes a halt until escape key pressed}
  108.  
  109.          '.': Image.Radius := 16;                   {Default}
  110.          '/': Image.Radius := Image.Radius shr 1;   {Reduce}
  111.          '*': Image.Radius := Image.Radius shl 1;   {Enlarge}
  112.          '+': begin
  113.                 Inc(FullSpeed);
  114.                 HalfSpeed := FullSpeed div 2;
  115.               end;
  116.          '-': begin
  117.                 Dec(FullSpeed);
  118.                 HalfSpeed := FullSpeed div 2;
  119.               end;
  120.          '8','I': Dec( Image.YSpeed, FullSpeed );   {N upwards}
  121.          '2','M': Inc( Image.YSpeed, FullSpeed );   {S downwards}
  122.          '4','J': Dec( Image.XSpeed, FullSpeed );   {W leftwards}
  123.          '6','K': Inc( Image.XSpeed, FullSpeed );   {E rightwards}
  124.          '0',' ': begin                             {Report statistics}
  125.                     SetColor( White );
  126.                     SetFillStyle( SolidFill, White );
  127.                     Rectangle(8,8,8+160,8+56);                      {box}
  128.                     SetViewPort(8,8,8+160,8+56, ClipOff);           {dialog}
  129.                     OutTextXY(2,2, '<ENTER> resumes');
  130.                     OutTextXY(2,2+8,  'x = ' + IntToStr(Image.XPos));
  131.                     OutTextXY(2,2+16, 'y = ' + IntToStr(Image.YPos));
  132.                     OutTextXY(2,2+24, 'dx = '+ IntToStr(Image.XSpeed));
  133.                     OutTextXY(2,2+32, 'dy = '+ IntToStr(Image.YSpeed));
  134.                     OutTextXY(2,2+40, 'Full Speed = '+ IntToStr(FullSpeed));
  135.  
  136.                     Ch := ReadKey;                 {repeat until keypressed}
  137.                     ClearViewPort;
  138.                     SetViewPort(0,0,GetMaxX,GetMaxY, ClipOn);       {window}
  139.                     Rectangle(0,0,GetMaxX,GetMaxY);                 {border}
  140.                     if (Ch = '0') then              {Stop motion}
  141.                      begin
  142.                        Image.XSpeed := 0;
  143.                        Image.YSpeed := 0;
  144.                      end;
  145.                   end;
  146.          '7','U': begin                      {NW}
  147.                     Dec(Image.XSpeed, HalfSpeed);
  148.                     Dec(Image.YSpeed, HalfSpeed);
  149.                   end;
  150.          '9','O': begin                      {NE}
  151.                     Inc(Image.XSpeed, HalfSpeed);
  152.                     Dec(Image.YSpeed, HalfSpeed);
  153.                   end;
  154.          '1','N': begin                      {SW}
  155.                     Dec(Image.XSpeed, HalfSpeed);
  156.                     Inc(Image.YSpeed, HalfSpeed);
  157.                   end;
  158.          '3',',': begin                      {SE}
  159.                     Inc(Image.XSpeed, HalfSpeed);
  160.                     Inc(Image.YSpeed, HalfSpeed);
  161.                   end;
  162.  
  163.      end;  {case}
  164.    end;
  165.    Inc( Image.YSpeed, HalfSpeed );  { Gravitation }  {jh Just so it can vary}
  166. end;
  167.  
  168. { ****************** UPDATE POSITIONS ****************** }
  169. procedure UpdatePositions;
  170. begin
  171.    Inc( Image.XPos, Image.XSpeed );
  172.    Inc( Image.YPos, Image.YSpeed );
  173. end;
  174.  
  175. { ****************** CHECK COLLISION ******************* }
  176. procedure CheckCollision;
  177. begin
  178.    with Image do
  179.    begin
  180.       if ( XPos - Radius ) <= 0 then  { Hit left wall }
  181.          begin
  182.          XPos   := Radius +1;
  183.          XSpeed := -Trunc( XSpeed *0.9 );
  184.          end;
  185.  
  186.       if ( XPos + Radius ) >= GetMaxX then { Hit right wall }
  187.          begin
  188.          XPos   := GetMaxX -Radius -1;
  189.          XSpeed := -Trunc( XSpeed *0.9 );
  190.          end;
  191.  
  192.       if ( YPos -Radius ) <= 0 then  { Hit roof }
  193.          begin
  194.          YPos   := Radius +1;
  195.          YSpeed := -Trunc( YSpeed *0.9 );
  196.          end;
  197.  
  198.       if ( YPos +Radius ) >= GetMaxY then { Hit floor }
  199.          begin
  200.          YPos   := GetMaxY -Radius -1;
  201.          YSpeed := -Trunc( YSpeed *0.9 );
  202.          end;
  203.    end;
  204. end;
  205.  
  206. { ********************* PROGRAM ************************ }
  207.  
  208. BEGIN
  209.    FullSpeed := 10;
  210.    HalfSpeed := FullSpeed div 2;
  211.    with Image do
  212.    begin
  213.       XPos   := 30;
  214.       YPos   := 30;
  215.       XSpeed := FullSpeed;
  216.       YSpeed :=  0;
  217.       XAccel :=  0;             {jh unused}
  218.       YAccel := 10;             {jh unused}
  219.  
  220.       Radius := 16;             {arbitrary}
  221.    end;
  222.  
  223.    Gd := Detect;
  224.    InitGraph( Gd, Gm, '');            {BGI drivers in Current Work Dir (CWD)}
  225.    Gd := GraphResult;
  226.    if (Gd <> grOK) then
  227.      begin
  228.        Gd := Detect;
  229.        InitGraph( Gd, Gm, '\TURBO\TP\');     {BGI drivers in default directory}
  230.      end;
  231.    Rectangle( 0, 0, GetMaxX, GetMaxY );                 {border}
  232.    SetViewPort( 0, 0, GetMaxX, GetMaxY, ClipOn );       {window}
  233.  
  234.    repeat
  235.       DrawImage;
  236.       Delay( 30 );    {milliseconds Frame delay}
  237.       RemoveImage;
  238.  
  239.       UpdateSpeed;
  240.       UpdatePositions;
  241.       CheckCollision;
  242.    until Ch = Chr( 27 );
  243.  
  244.    CloseGraph;
  245. END.
  246.